DISCLAMER:

These are recent notes that are not intended to be comprehensive.

library(geneorama)

CLIPBOARD ACCESS FOR LINUX… FINALLY

## Install xclip first:
"$ sudo apt-get install xclip"

# Install from CRAN
install.packages("clipr")

# Or try the development version
devtools::install_github("mdlincoln/clipr")

# library("clipr")
cb <- clipr::read_clip()

cb <- write_clip(c("Text", "for", "clipboard"))
cb <- write_clip(c("Text", "for", "clipboard"), breaks = ", ")

## Future use in geneorama?
## Nice fread example
con <- pipe("xclip -o -selection clipboard")
content <- scan(con, what = character(), sep = "\n", blank.lines.skip = FALSE, quiet = TRUE)
fread(paste(content, collapse = "\n"))
close(con)

Record your screen in Linux

This isn’t R, but it’s amazing. Use this code to record your screen in Linux. Source: http://www.commandlinefu.com/commands/browse

"ffmpeg -f x11grab -r 25 -s 800x600 -i :0.0 /tmp/outputFile.mpg"

Add alpha to a plot & Smooth Scatter example

# source:
# http://menugget.blogspot.com/2012/04/adding-transparent-image-layer-to-plot.html

add_alpha <- function(COLORS, ALPHA){
    if(missing(ALPHA)) stop("provide a value for alpha between 0 and 1")
    RGB <- col2rgb(COLORS, alpha=TRUE)
    RGB[4,] <- round(RGB[4,]*ALPHA)
    NEW.COLORS <- rgb(RGB[1,], RGB[2,], RGB[3,], RGB[4,], maxColorValue = 255)
    return(NEW.COLORS)
}
cols <- c('transparent','blue','yellow','red','darkred')
colramp <- colorRampPalette(add_alpha(cols, .5), alpha=T)
df <- data.table(x=rnorm(100), y=rnorm(100))
df[ , plot(x,y)]

## NULL

df[ , smoothScatter(x,y,colramp = colramp, add=TRUE,
                        nbin = c(300, 300), bandwidth = c(.2, .2),
                        transformation=function(x) sqrt(x))]

## NULL

Get google map and plot it

library(ggmap)

## Loading required package: ggplot2

set_project_dir("geneorama")
infile <- "doc/ggmap_chicago.Rds"

## LOAD DATA
## Also, clean up variable names, and convert dates
if(!file.exists(infile)){
    mapdata <- get_map("Chicago, Illinois", zoom=10)
    saveRDS(mapdata, infile)
}
mapdata <- readRDS(infile)

ggmap(mapdata)

str(mapdata)

##  chr [1:1280, 1:1280] "#EAE7E0" "#E7E6DE" "#F1EFEC" "#F4F1EF" ...
##  - attr(*, "class")= chr [1:2] "ggmap" "raster"
##  - attr(*, "bb")='data.frame':   1 obs. of  4 variables:
##   ..$ ll.lat: num 41.5
##   ..$ ll.lon: num -88.1
##   ..$ ur.lat: num 42.2
##   ..$ ur.lon: num -87.2
##  - attr(*, "source")= chr "google"
##  - attr(*, "maptype")= chr "terrain"
##  - attr(*, "zoom")= num 10

# saveRDS(mapdata, "ggmap_data.Rds")

Make a color palette

library()

## Warning in library(): libraries '/usr/local/lib/R/site-library', '/usr/lib/
## R/site-library' contain no packages

pal <- leaflet::colorQuantile("Greens", NULL, n = 6)
pal <- leaflet::colorNumeric('PuBuGn', 10)

df <- data.table(x=rnorm(1000), y=rnorm(1000))
vals <- df[,1/(3+(x+y)^2)]
pal <- leaflet::colorNumeric('PuBuGn', range(vals))
df[ , plot(y~x, pch=19, col=pal(vals), cex=5)]

## NULL

Display color palettes (color blind friendly)

RColorBrewer::display.brewer.all(colorblindFriendly=TRUE)

RColorBrewer::brewer.pal.info

##          maxcolors category colorblind
## BrBG            11      div       TRUE
## PiYG            11      div       TRUE
## PRGn            11      div       TRUE
## PuOr            11      div       TRUE
## RdBu            11      div       TRUE
## RdGy            11      div      FALSE
## RdYlBu          11      div       TRUE
## RdYlGn          11      div      FALSE
## Spectral        11      div      FALSE
## Accent           8     qual      FALSE
## Dark2            8     qual       TRUE
## Paired          12     qual       TRUE
## Pastel1          9     qual      FALSE
## Pastel2          8     qual      FALSE
## Set1             9     qual      FALSE
## Set2             8     qual       TRUE
## Set3            12     qual      FALSE
## Blues            9      seq       TRUE
## BuGn             9      seq       TRUE
## BuPu             9      seq       TRUE
## GnBu             9      seq       TRUE
## Greens           9      seq       TRUE
## Greys            9      seq       TRUE
## Oranges          9      seq       TRUE
## OrRd             9      seq       TRUE
## PuBu             9      seq       TRUE
## PuBuGn           9      seq       TRUE
## PuRd             9      seq       TRUE
## Purples          9      seq       TRUE
## RdPu             9      seq       TRUE
## Reds             9      seq       TRUE
## YlGn             9      seq       TRUE
## YlGnBu           9      seq       TRUE
## YlOrBr           9      seq       TRUE
## YlOrRd           9      seq       TRUE

LEAFLET EXAMPLE FROM GIS STACK EXCHANGE

http://gis.stackexchange.com/questions/168886/r-how-to-build-heatmap-with-the-leaflet-package/203623#203623

Modified to use RCurl and adding elements from example from food-inspections-model (recent branch)

set_project_dir("geneorama")

## INITIALIZE
loadinstall_libraries(c("leaflet", "data.table", "sp", "rgdal", "KernSmooth", "RCurl"))

## 
## Loading required libraries:
## Attaching: leaflet 
## Attaching: data.table 
## Attaching: sp 
## Attaching: rgdal

## rgdal: version: 1.1-10, (SVN revision 622)
##  Geospatial Data Abstraction Library extensions to R successfully loaded
##  Loaded GDAL runtime: GDAL 1.11.3, released 2015/09/16
##  Path to GDAL shared files: /usr/share/gdal/1.11
##  Loaded PROJ.4 runtime: Rel. 4.9.2, 08 September 2015, [PJ_VERSION: 492]
##  Path to PROJ.4 shared files: (autodetected)
##  Linking to sp version: 1.2-3

## Attaching: KernSmooth

## KernSmooth 2.23 loaded
## Copyright M. P. Wand 1997-2009

## Attaching: RCurl

# library("maptools")

inurl <- "https://data.cityofchicago.org/api/views/22s8-eq8h/rows.csv?accessType=DOWNLOAD"
infile <- "doc/mvthefts.Rds"

## LOAD DATA
## Also, clean up variable names, and convert dates
if(!file.exists(infile)){
    # download.file(url = inurl, destfile = infile)
    dat <- fread(RCurl::httpGET(inurl)[1])
    setnames(dat, tolower(colnames(dat)))
    setnames(dat, gsub(" ", "_", colnames(dat)))
    dat <- dat[!is.na(longitude)]
    dat[ , date := as.IDate(date, "%m/%d/%Y")]
    saveRDS(dat, infile)
}
dat <- readRDS(infile)

## MAKE CONTOUR LINES
## Note, bandwidth choice is based on MASS::bandwidth.nrd()
kde <- bkde2D(dat[ , list(longitude, latitude)],
              bandwidth=c(.0045, .0068), gridsize = c(100,100))
CL <- contourLines(kde$x1 , kde$x2 , kde$fhat)

## EXTRACT CONTOUR LINE LEVELS
LEVS <- as.factor(sapply(CL, `[[`, "level"))
NLEV <- length(levels(LEVS))

## CONVERT CONTOUR LINES TO POLYGONS
pgons <- lapply(1:length(CL), function(i)
    Polygons(list(Polygon(cbind(CL[[i]]$x, CL[[i]]$y))), ID=i))
spgons = SpatialPolygons(pgons)

## MAPBOX INFO
MAPBOX_STYLE_TEMPLATE <- paste0("https://api.mapbox.com/styles/v1/coc375492/",
                                "cirqd7mgf001ygcnombg4jtb4/tiles/256/{z}/{x}/{y}",
                                "?access_token=pk.eyJ1IjoiY29jMzc1NDkyIiwiYSI6ImN",
                                "pcnBldzVqMTBmc3J0N25rZTIxZ3ludDIifQ.DgJIcLDjC1h9MtT8CaJ-pQ")
mb_attribution <- paste("© <a href='https://www.mapbox.com/about/maps/'>Mapbox</a> ",
                        "© <a href='http://www.openstreetmap.org/about/'>OpenStreetMap</a>")


## Leaflet map with points and polygons
## Note, this shows some problems with the KDE, in my opinion...
## For example there seems to be a hot spot at the intersection of Mayfield and
## Fillmore, but it's not getting picked up.  Maybe a smaller bw is a good idea?

dat[ , LABEL := paste0(date, " | ", location_description, " | arrest:", arrest)]

# pal <- leaflet::colorQuantile("Greens", NULL, n = NLEV)
pal <- leaflet::colorFactor("Greens", NULL, levels = NLEV)
pal <- leaflet::colorFactor("Greens", levels = -NLEV:NLEV)
# pal <- leaflet::colorNumeric('PuBuGn', -5:NLEV)
# pal <- leaflet::colorNumeric('PuOr', NLEV:-1)
leaflet(spgons) %>% 
    # addProviderTiles("CartoDB.Positron") %>%
    addTiles(urlTemplate = MAPBOX_STYLE_TEMPLATE, attribution = mb_attribution)     %>%
    # addPolygons(color = heat.colors(NLEV, NULL)[LEVS], weight=1, fillOpacity=.25) %>%
    addPolygons(color = pal(as.numeric(LEVS)), weight=1, fillOpacity=.25) %>%
    addCircles(lng = ~longitude, lat = ~latitude, weight = 3, popup = ~LABEL,
               data = dat, radius = .5, opacity = .4, 
               col = ifelse(dat$arrest=="true", "yellow", "red")) %>% 
    addLegend(pal = pal, 
              values = LEVS, 
              position = "bottomright", 
              title = "Crime Intensity") %>% 
    addLegend(colors = c("yellow", "red"),
              labels = c("true", "false"), 
              position = "bottomleft", 
              title = "Arrest")

## Uncomment to save results
# library(maptools)
# spdf <- SpatialPolygonsDataFrame(spgons, as.data.frame(LEVS), match.ID = F)
# dircreate("mapdata")
# writePolyShape(spdf, "mapdata/any_name")

Stat density

geneorama::loadinstall_libraries(c("geneorama", "ggmap", "ggplot2"))

## 
## Loading required libraries:
## Attaching: geneorama 
## Attaching: ggmap 
## Attaching: ggplot2

set_project_dir("geneorama")
infile <- "doc/ggmap_chicago.Rds"

## LOAD MAP DATA
## Also, clean up variable names, and convert dates
if(!file.exists(infile)){
    mapdata <- get_map("Chicago, Illinois", zoom=10)
    saveRDS(mapdata, infile)
}
mapdata <- readRDS(infile)

## LOAD CRIME DATA
inurl <- "https://data.cityofchicago.org/api/views/22s8-eq8h/rows.csv?accessType=DOWNLOAD"
infile <- "doc/mvthefts.Rds"

## LOAD DATA
## Also, clean up variable names, and convert dates
if(!file.exists(infile)){
    # download.file(url = inurl, destfile = infile)
    dat <- fread(RCurl::httpGET(inurl)[1])
    setnames(dat, tolower(colnames(dat)))
    setnames(dat, gsub(" ", "_", colnames(dat)))
    dat <- dat[!is.na(longitude)]
    dat[ , date := as.IDate(date, "%m/%d/%Y")]
    saveRDS(dat, infile)
}
dat <- readRDS(infile)

## Crime points
cpts <- dat[,list(lon=longitude, lat=latitude)]

## Density plot (built into ggplot)
base_plot <- ggmap(mapdata)
base_plot + stat_density2d(data=cpts, aes(group=1), color = 4)

## Contour lines - Build kernel density
rng <- unname(unlist(cpts[ , list(range(lon), range(lat))]))
cdens <- MASS::kde2d(x = cpts$lon, y = cpts$lat, h = .03, n = 100, lims = rng)
cdens_dt <- data.table(z=melt(cdens$z))
setnames(cdens_dt, c("x", "y", "z"))
cdens_dt[ , x:=cdens$x[cdens_dt$x]]
cdens_dt[ , y:=cdens$y[cdens_dt$y]]
cdens_dt

##                x        y             z
##     1: -87.90646 41.64820 1.559735e-109
##     2: -87.90261 41.64820 2.646971e-106
##     3: -87.89875 41.64820 3.450761e-103
##     4: -87.89489 41.64820 3.455719e-100
##     5: -87.89104 41.64820  2.658338e-97
##    ---                                 
##  9996: -87.54008 42.02253  3.729963e-51
##  9997: -87.53622 42.02253  4.408004e-54
##  9998: -87.53237 42.02253  4.026018e-57
##  9999: -87.52851 42.02253  2.838198e-60
## 10000: -87.52465 42.02253  1.542649e-63

## Contour lines - Plot without base layer (proof of concept)
ggplot(data = cdens_dt, aes(x,y,z=z)) + stat_contour(aes(x,y,z=z))

## Contour lines
base_plot + stat_contour(data = cdens_dt, aes(x,y,z=z, group=1))

base_plot + stat_contour(data = cdens_dt, aes(x,y,z=z, group=1)) +
    annotate("text", x = -87.825, y = 41.73, label=paste0("Chicago"), size=8)

base_plot + stat_contour(data = cdens_dt, 
                         aes(x,y,z=z, group=1, colour = ..level..), size=1)

base_plot + 
    stat_contour(data = cdens_dt, geom="polygon", alpha=.2,
                 aes(x,y,z=z, group=1, fill = ..level..)) +
    annotate("text", x = -87.825, y = 41.73,
             label=paste0("Burglary density\nin 2013"), size=7)